home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
clipper
/
rlib20.zip
/
DEMO.PRG
< prev
next >
Wrap
Text File
|
1989-02-18
|
33KB
|
898 lines
* Program.: DEMO.PRG
* Author..: Richard Low
* Date....: October 6, 1988
* Notes...: Program to demonstrate the RLIB functions.
*
PARAMETER edit
*-- the command line argument "EDIT" will allow mods to memo fields
*-- (I used this flag to build the descriptions )
edit = IF( PCOUNT() = 1, ( UPPER(edit) = 'EDIT' ), .F. )
IF .NOT. FILES('demo.dbf', 'demo.dbt')
? 'This demo requires the database file DEMO.DBF and its associated memo'
? 'file DEMO.DBT which are included in the RLIB package. Please place'
? 'these two files in the current default directory and try again.'
? CHR(7)
RETURN
ENDIF
SET PROCEDURE TO demoproc
SAVE SCREEN TO dosscreen
saverow = ROW()
savecol = COL()
SET COLOR TO W/N
CLEAR
@ 3,0
TEXT
Welcome to the RLIB demonstration program. The purpose of this demo is to
show what RLIB functions can do. It can also serve as a supplement to the
documentation by providing examples of RLIB functions in use.
The demo starts by presenting you with a menu of RLIB function categories.
Each of these categories presents a sub - menu with the available choices.
The starting menu is a BOXMENU, but you may change the style of menus used
for the demonstration at any time. Simply select from the Menuing Tools
menu the style of menu you want, and the demo will continue, but under the
style of menu you have chosen.
ENDTEXT
@ 1,0,18,79 BOX '┌─┐│┘─└│'
*-- first need to initialize all public variables and arrays
DO initialize
CENTER( 16, 'Press any key to begin...' )
x = INKEY(30)
DO WHILE x = 0
x = ASC(BOXASK('N/W','The demo will start as soon as you press a key',4))
x = IF( x = 0, INKEY(10), x )
ENDDO
CLEAR
IF LASTKEY() = 27
RETURN
ENDIF
SET CURSOR OFF
*-- Each active menu routine may control the whole demo. If the user
*-- selectes a different menu control, the current routine will set
*-- <menustyle> accordingly and exit back to this main loop. The
*-- Summer '87 BEGIN SEQUENCE facility is used to allow conditional
*-- branching back to this main routine from within the other procs.
PUBLIC menustyle, showtime, dummy, single, double
menustyle = 2 && start off with BOXMENU
showtime = 2 && seconds to pause while showing syntax
dummy = '' && global DUMMY parameter
single = '┌─┐│┘─└│' && used for single line boxes
double = '╔═╗║╝═╚║' && used for double line boxes
*-- open the demo database so quickley retrieve syntax descriptions
USE demo INDEX demo
*-- each routine will set menustyle to 0 to quit
DO WHILE menustyle > 0
BEGIN SEQUENCE
DO CASE
CASE menustyle = 1
DO bardemo
CASE menustyle = 2
DO boxdemo
CASE menustyle = 3
DO multdemo
CASE menustyle = 4
DO pulldemo
ENDCASE
END
ENDDO
RESTORE SCREEN FROM dosscreen
@ saverow,savecol SAY ''
CLOSE DATABASES
SET CURSOR ON
SET COLOR TO
CLEAR ALL
RETURN
*-- End of main program.
*----------------------------------------------------------------------------
* Procedure: INITIALIZE
* Notes....: Procedure to initialize demo procedure names into a PUBLIC
* array to be later referenced via the DIM2() UDF.
* These demo procedures are called via macro substitution at
* run time by first retrieving the name of the demo procedure
* to run from the combination of menu options chosen. These
* options pair correspond to the DIM2 location of the procedure
* name in the <demos> array, which, thanks to the DIM@() UDF,
* looks and acts like a two dimensional array.
*----------------------------------------------------------------------------
PROCEDURE initialize
*-- set color variables and arrays for the demo
PUBLIC democolor, syntaxcolor, background
IF ISCOLOR()
PUBLIC boxcolors[5], barcolors[5], pullcolors[6], multicolors[5]
democolor = 'W/B,N/W,N,N,N/BG'
syntaxcolor = 'N/BG,W/B,N,N,N/B'
background = 'W/N,N/W,N,N,N/W'
boxcolors[1] = 'W/B' && White on Blue display
boxcolors[2] = 'N/BG' && Black on Cyan menu bar
boxcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
boxcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
boxcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
barcolors[1] = 'W/B' && White on Blue display
barcolors[2] = 'N/BG' && Black on Cyan menu bar
barcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
barcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
barcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
pullcolors[1] = 'W/B' && White on Blue display
pullcolors[2] = 'N/BG' && Black on Cyan menu bar
pullcolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
pullcolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
pullcolors[5] = 'GR+/B' && Yellow on Blue for the selected option
pullcolors[6] = 'GR+/B'
multicolors[1] = 'W/B' && White on Blue display
multicolors[2] = 'N/BG' && Black on Cyan menu bar
multicolors[3] = 'BG+/B' && Bright Cyan on Blue Active Border
multicolors[4] = 'BG/B' && Regular Cyan on Blue In-active Border
multicolors[5] = 'GR+/B' && Yellow on Blue for the selected option
ELSE
PUBLIC boxcolors, barcolors, pullcolors
democolor = 'W/N,N/W,N,N,U'
syntaxcolor = 'N/W,W/N,N,N,U'
background = 'W/N,N/W,N,N,U'
STORE '' TO boxcolors, barcolors, pullcolors
PUBLIC multicolors[5]
multicolors[1] = 'W/N' && White on Black display
multicolors[2] = 'N/W' && Black on White menu bar
multicolors[3] = ' '
multicolors[4] = ' '
multicolors[5] = 'W+/N' && Bright White for selected option
ENDIF
PUBLIC rows, cols && this is required by the DIM2() UDF
rows = 6 && six groups of functions
cols = 7 && maximum number in each group
PUBLIC demos[ rows * cols ]
demos[ DIM2(1,1) ] = 'd'
demos[ DIM2(1,2) ] = 'd'
demos[ DIM2(1,3) ] = 'd'
demos[ DIM2(1,4) ] = 'd'
demos[ DIM2(2,1) ] = 'd_atinsay' && Screen functions
demos[ DIM2(2,2) ] = 'd_boxask'
demos[ DIM2(2,3) ] = 'd_bright'
demos[ DIM2(2,4) ] = 'd_center'
demos[ DIM2(2,5) ] = 'd_multimenu'
demos[ DIM2(2,6) ] = 'd_sayinbox'
demos[ DIM2(3,1) ] = 'd_filedate' && File functions
demos[ DIM2(3,2) ] = 'd_files'
demos[ DIM2(3,3) ] = 'd_filetime'
demos[ DIM2(3,4) ] = 'd_parent'
demos[ DIM2(3,5) ] = 'd_pathto'
demos[ DIM2(3,6) ] = 'd_pickfile'
demos[ DIM2(4,1) ] = 'd_decrypted' && Character
demos[ DIM2(4,2) ] = 'd_encrypted'
demos[ DIM2(4,3) ] = 'd_getparm'
demos[ DIM2(4,4) ] = 'd_keyinput'
demos[ DIM2(4,5) ] = 'd_namesplit'
demos[ DIM2(4,6) ] = 'd_rjustify'
demos[ DIM2(5,1) ] = 'd_changed' && Database
demos[ DIM2(5,2) ] = 'd_closearea'
demos[ DIM2(5,3) ] = 'd_forget'
demos[ DIM2(5,4) ] = 'd_markrec'
demos[ DIM2(5,5) ] = 'd_memorize'
demos[ DIM2(5,6) ] = 'd_mreplace'
demos[ DIM2(5,7) ] = 'd_pickrec'
demos[ DIM2(6,1) ] = 'd_alphadate' && Other
demos[ DIM2(6,2) ] = 'd_beep'
demos[ DIM2(6,3) ] = 'd_ntxkeyval'
demos[ DIM2(6,4) ] = 'd_str2date'
USE demo
INDEX ON udf_name TO demo
USE
RETURN
*----------------------------------------------------------------------------
* Function: DIM2
* Notes...: UDF to emulate 2 dimensional arrays.
*----------------------------------------------------------------------------
FUNCTION dim2
PARAMETERS x,y
RETURN (((x - 1) * cols) + y)
*----------------------------------------------------------------------------
* Procedure